temp-bikes/05 Local Gewisano/local_gewi_datascript.R

In ooelrich/oscbvar: Stuff for Bayesian vector autoregressions

library(data.table)
library(ggplot2)
################################################################
### Local gewisano predictions for a selection of cw-values  ###
################################################################

tempfun1 <- function(cw) {
    weights <- caliper_relevance_new(
        atomic_df = bikes_atom,
        sotw = subset(bikes_d_log, select = c(t, temp, hum, windspeed)),
        start_agg = 401,
        cw = cw,
        matching_vars = NULL
    )

    dfg <- gen_gewisano_local(
        data = bikes_atom,
        start_t = 401,
        weight_df = weights,
        pratig = TRUE
    )
    return(dfg)
}

cw_vals <- c(0.001, 0.01, 0.1, 0.2, 0.5, 1)
gewlist_nomatch <- lapply(cw_vals, tempfun1)

local_gew_nomatch <- list()
for (i in seq_len(length(gewlist_nomatch))) {
    local_gew_nomatch[[i]] <- gewlist_nomatch[[i]][[1]]
}

names(local_gew_nomatch) <- cw_vals
dfall_nomatch <- data.table::rbindlist(local_gew_nomatch, idcol = "cw")
saveRDS(dfall_nomatch, file = "temp/dfall_nomatch.Rds")

ggplot(dfall_nomatch, aes(x = t, y = lpdens, col = cw)) + geom_line()
ggsave("temp/local_gewisano.pdf")


###############################################################################
### Local gewisano predictions for a selection of cw-valuesm with matching  ###
###############################################################################

tempfun2 <- function(cw) {
    # No global var nonsense
    matchi <- data.frame(t = 1:730, family_day = 0)
    matchi[c(327, 357:358, 691, 723:724), 2] <- 1

    weights <- caliper_relevance_new(
        atomic_df = bikes_atom,
        sotw = subset(bikes_d_log, select = c(t, temp, hum, windspeed)),
        start_agg = 401,
        cw = cw,
        matching_vars = matchi
    )

    dfg <- gen_gewisano_local(
        data = bikes_atom,
        start_t = 401,
        weight_df = weights,
        pratig = TRUE
    )
    return(dfg)
}

gewlist_match <- lapply(c(0.001, 0.01, 0.1, 0.2, 0.5, 1), tempfun1)